home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
program
/
pcl4p51.zip
/
LOGIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-06-05
|
7KB
|
217 lines
(*********************************************)
(* *)
(* LOGIN.PAS April 96 *)
(* *)
(* This program is donated to the Public *)
(* Domain by MarshallSoft Computing, Inc. *)
(* It is provided as an example of the use *)
(* of the Personal Communications Library. *)
(* *)
(*********************************************)
program login;
uses crt, modem_io, PCL4P;
const
ONE_SEC = 18;
const
BaudRateArray : array[1..10] of LongInt =
(300,600,1200,2400,4800,9600,19200,38400,57600,115200);
var
BaudCode : Integer;
Code : Integer;
Byte : Char;
i : Integer;
Port : Integer;
ResetFlag: Boolean;
CharPace : Integer;
BufPtr : Pointer;
BufSeg : Integer;
procedure SayError( Code : Integer );
begin
if Code < 0 then Code := SioError( Code )
else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
begin (* Port Error *)
if (Code and FramingError) <> 0 then writeln('Framing Error');
if (Code and ParityError) <> 0 then writeln('Parity Error');
if (Code and OverrunError) <> 0 then writeln('Overrun Error')
end
end;
(*** send string & expect reply ***)
function PutGet(Send:String; Expect:String; Tics:Integer) : Char;
var
Code : Integer;
Flag : Boolean;
Byte : Char;
begin
Byte := chr(0);
WriteLn;
Write('*** Sending "',Send,'"');
if Length(Expect) > 0 then Write(' & awaiting "',Expect,'"');
WriteLn;
(*function ModemSendTo(Port:Integer;Pace:Integer;TheString:String):Boolean;*)
(*function ModemWaitFor(Port:Integer;WaitTics:Integer;CaseFlag:Boolean;TheString:String):Char;*)
Flag := ModemSendTo(Port, CharPace, Send);
if Flag and (Length(Expect) > 0) then
begin
Byte := ModemWaitFor(Port,Tics,FALSE,Expect);
if Byte = chr(0) then WriteLn('ERROR: "',Send,'" sent but "',Expect,'" not received');
end;
PutGet := Byte;
end;
procedure MyHalt( ExitCode : Integer );
begin
if ExitCode < 0 then SayError( ExitCode );
if ResetFlag then Code := SioDone(Port);
writeln('*** HALTING ***');
Halt;
end;
function MatchBaud(BaudString : String) : Integer;
var
i : Integer;
BaudRate: LongInt;
Code : Integer;
begin
Val(BaudString,BaudRate,Code);
if Code <> 0 then
begin
MatchBaud := -1;
exit;
end;
for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
begin
MatchBaud := i - 1;
exit;
end;
(* no match *)
MatchBaud := -1;
end;
begin (* main program *)
ResetFlag := FALSE;
CharPace := 3;
(* fetch PORT # from command line *)
if ParamCount <> 2 then
begin
writeln('USAGE: "LOGIN <port> <baud rate>" where port = 1 to 20');
halt;
end;
Val( ParamStr(1),Port, Code );
if Code <> 0 then
begin
writeln('Port must be 1 to 16');
Halt;
end;
(* COM1 = 0, COM2 = 1, etc. *)
Port := Port - 1;
if (Port<COM1) or (Port>COM16) then
begin
writeln('Port must be 1 to 16');
Halt
end;
(* get baud rate *)
BaudCode := MatchBaud(ParamStr(2));
(* setup 1K receive buffer *)
GetMem(BufPtr,1024+16);
BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
Code := SioRxBuf(Port, BufSeg, Size1024);
if Code < 0 then MyHalt( Code );
if SioInfo('I') > 0 then
begin
(* setup 128 transmit buffer *)
GetMem(BufPtr,128+16);
BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
Code := SioTxBuf(Port, BufSeg, Size128);
if Code < 0 then MyHalt( Code );
end;
(* reset port *)
Code := SioReset(Port,BaudCode);
(* if error then try one more time *)
if Code <> 0 then Code := SioReset(Port,BaudCode);
(* Was port reset ? *)
if Code <> 0 then
begin
writeln('Cannot reset COM',Port+1);
MyHalt( Code );
end;
(* Port successfully reset *)
writeln;
writeln('COM',1+Port,' @ ',BaudRateArray[BaudCode+1],' Baud');
ResetFlag := TRUE;
(* specify parity, # stop bits, and word length for port *)
Code := SioParms(Port, NoParity, OneStopBit, WordLength8);
if Code < 0 then MyHalt( Code );
(* set FIFO level if have INS16550 *)
Code := SioFIFO(Port, LEVEL_8);
if Code < 0 then MyHalt( Code );
Code := SioRxClear(Port);
if Code < 0 then MyHalt( Code );
(* set DTR & RTS *)
Code := SioDTR(Port,SetPort);
Code := SioRTS(Port,SetPort);
(* initialize (Hayes compatible) modem *)
Byte := PutGet('!AT!','OK',ONE_SEC);
if Byte <> chr(0) then Byte := PutGet('AT E1 S7=60 S11=60 V1 X1 Q0!','OK',5*ONE_SEC);
if Byte <> chr(0) then
begin
WriteLn(' <<Modem ready. Logging on...>>');
(* dial number & wait for CONNECT *)
Byte := PutGet('!ATDT1,205,880,9748!','CONNECT',60*ONE_SEC);
if Byte = chr(0) then MyHalt(0);
Byte := PutGet('!','graphics (y/N)?|LAST name:',45*ONE_SEC);
if Byte = chr(0) then MyHalt(0);
(* '0' means 1st arg matched, '1' means second arg matched *)
if Byte = '0' then Byte := PutGet('!','LAST Name:',10*ONE_SEC);
Byte := PutGet('GUEST GUEST!','password:',10*ONE_SEC);
if Byte = chr(0) then MyHalt(0);
Byte := PutGet('GUEST!','',10*ONE_SEC);
end
else WriteLn(' <<WARNING: Expected OK not received>>');
(* begin terminal loop *)
writeln('Enter terminal loop ( Type ^Z to exit )');
while TRUE do
begin
(* did user press Ctrl-BREAK ? *)
if SioBrkKey then
begin
writeln('User typed Ctl-BREAK');
Code := SioDone(Port);
Halt;
end;
(* anything incoming over serial port ? *)
Code := SioGetc(Port,0);
if Code < -1 then MyHalt( Code );
if Code > -1 then Write( chr(Code) );
(* has user pressed keyboard ? *)
if KeyPressed then
begin
(* read keyboard *)
Byte := ReadKey;
(* quit if user types ^Z *)
if Byte = chr($1a) then
begin
writeln('User typed ^Z');
Code := SioDone(Port);
Halt;
end;
(* send out over serial line *)
Code := SioPutc(Port, Byte );
if Code < 0 then MyHalt( Code );
end
end
end.